home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1997 February
/
EnigmA AMIGA RUN 15 (1997)(G.R. Edizioni)(IT)[!][issue 1997-02][PLANET CD V].iso
/
enigma
/
earcd
/
comm
/
comm5
/
dlmgr.lha
/
DLManager.thor
< prev
Wrap
Text File
|
1996-12-24
|
9KB
|
399 lines
/*
** Filename: DLManager.thor
**
** $VER: 1.0 (21.12.96)
**
** Author: Troy E. Bouchard
**
*/
SIGNAL ON SYNTAX
SIGNAL ON HALT
EVE_ENTERMSG = 0
/* Find our Thor Port and number! */
p = Address() || ' ' || show('P',,)
ThorPort = pos('THOR.',p)
if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
else
do
say "Can't seem to find the Thor port!"
exit 10
End
/* Load the BBSRead library up! */
if ~show('p', 'BBSREAD') then
do
address command
"run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
"WaitForPort BBSREAD"
End
if ~Show('L','rexxarplib.library') then
do
if ~AddLib('rexxarplib.library',0,-30,0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT '"Couldn't open rexxarplib.library"' BT "_Exiting!"'
exit 5
end
end
if ~Show('L','rexxsupport.library') then
do
if ~AddLib('rexxsupport.library',0,-30,0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT '"Couldn't open rexxsupport.library"' BT "_Exiting!"'
exit 5
end
end
'GetGlobalConfig stem "'GC'"'
options results
MyPort = OpenPort(DLPORT)
if MyPort = 0 then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT '"Couldn't open the port"' BT "_Exiting!"'
exit 5
end
address AREXX ,
"'Call CreateHost(DLHOST,DLPORT)'"
do i = 1 to 10
if ~Showlist('P',DLHOST) then call delay 50
else leave i
end
if i = 10 & ~Showlist('P',DLHOST) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT '"Couldn't open the Host"' BT "_Exiting!"'
exit 5
end
call CreateWIN()
Address(ThorPort)
'CURRENTSYSTEM stem "'BBSN'"'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'Thor.LASTERROR'" BT "_Ok"'
Call Cleanup
end
TB_SYSTEM = BBSN.BBSNAME
window.text = 'Current System: 'TB_SYSTEM
Call WindowText(DLHOST, window.text)
WaitStuff:
fini = 0
do forever
if fini = 1 then leave
t = waitpkt(DLPORT)
do i = 1
p = getpkt(DLPORT)
if c2d(p) = 0 then leave i
cmd = getarg(p)
j = reply(p,0)
Select
When cmd = CLOSEWINDOW then do
Call Quit()
end
When cmd = GETSYSTEM then do
Call GetSystem()
win.txt = 'Current System: 'TB_SYSTEM
Call WindowText(DLHOST, win.txt)
end
When cmd = NEWLIST then do
Call NewList()
end
When cmd = WRITEMSG then do
Call WriteMSG()
end
When cmd = DELLIST then do
Call DeleteList
end
When cmd = QUIT then do
Call Quit()
end
otherwise nop
end
end
end
Return
CreateWIN:
voffseta=0
voffsetb=0
gad. = ""
gad.0 = 28
win.idcmp = "+CLOSEWINDOW+GADGETUP"
win.flags = "+WINDOWCLOSE+WINDOWDEPTH+BACKFILL+ACTIVATE"
win.title = "DLManager v1.0"
gad.1.x = 30
gad.1.y = 38+voffseta
gad.1.name = "GETSYSTEM"
gad.1.text = " Get System "
gad.1.reportstring = "%d"
gad.2.x = 30
gad.2.y = 56+voffseta
gad.2.name = "NEWLIST"
gad.2.text = " New List "
gad.2.reportstring = "%d"
gad.3.x = 156
gad.3.y = 38+voffseta
gad.3.name = "WRITEMSG"
gad.3.text = " Write Mesg "
gad.3.reportstring = "%d"
gad.4.x = 156
gad.4.y = 56+voffseta
gad.4.name = "DELLIST"
gad.4.text = " Delete List"
gad.4.reportstring = "%d"
gad.5.x = 94
gad.5.y = 76+voffseta
gad.5.name = "QUIT"
gad.5.text = " Quit "
gad.5.reportstring = "%d"
call SetReqColor(DLHOST,BACKGROUND,3) /* Color the Background */
call OpenWindow(DLHOST, 160, 70, 285, 100, win.idcmp, win.flags, win.title)
CNT = 0
do n = 1 to gad.CNT
if gad.n.length = "" then
call Addgadget(DLHOST, gad.n.x, gad.n.y, ,
gad.n.name, gad.n.text, gad.n.reportstring)
else
call Addgadget(DLHOST, gad.n.x, gad.n.y, ,
gad.n.name, gad.n.text, gad.n.reportstring, ,
gad.n.length)
end
/* Color the Gadgets (set activate -> ON */
Call SetGadget(DLHOST, GETSYSTEM, ON)
Call SetGadget(DLHOST, NEWLIST, ON)
Call SetGadget(DLHOST, WRITEMSG, ON)
Call SetGadget(DLHOST, DELLIST, ON)
Call SetGadget(DLHOST, QUIT, ON)
Return
GetSystem:
window.text = 'Current System: (None)'
Address BBSREAD
'GETBBSLIST stem "'BBSLIST'"'
if(rc ~= 0) then
do
address(thorport)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_Ok"'
Call Cleanup
end
Address(ThorPort)
'REQUESTLIST instem "'BBSLIST'" title "Select System:" SizeGadget'
if(rc ~= 0) then
do
Call WindowText(DLHOST, window.text)
Return
end
TB_SYSTEM = result
Return(TB_SYSTEM)
AddTDL:
Address(ThorPort)
'RequestFile Title "Select the .tdl file" ID "'GC.SAVEDIR'" FP PAT "#?.tdl"'
if(rc = 5) then
do
'RequestNotify Text "Request Aborted!" BT "_Wow!"'
Call WaitStuff
end
choice = result
if ~Exists(choice) then
do
Call Open out, choice, 'w'
Call Close out
end
Return
NewList:
Call AddTDL
Address BBSREAD
'SearchBRUser BBSNAME "'TB_SYSTEM'" Stem "'SResult'" Search "#?" Name Address'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
Call Cleanup
end
if(result > 0) then
do
Address BBSREAD
drop LIST.
drop USERTAGS.
LIST.COUNT = SResult.COUNT
do j=1 to SResult.COUNT
LIST.j.USERNR = SResult.j.USERNR
'READBRUSER BBSNAME "'TB_SYSTEM'" UserNR "'SResult.j.USERNR'" TagsStem "'USERTAGS'"'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
Return
End
LIST.j = USERTAGS.NAME || ' ' || USERTAGS.ADDRESS
end
Address(ThorPort)
'REQUESTLIST instem "'LIST'" outstem "'USEL'" Title "Get User:" MultiSelect'
if(rc ~= 0) then
do
'REQUESTNOTIFY TEXT "Command Cancelled" BT "_OK"'
Return
end
end
Call Open out, Choice, 'a'
do k = 1 to USEL.COUNT /* Will appear as such: */
Call WriteLN out, '%' /* % */
Call WriteLN out, USEL.k /* Troy tbouchar@ptialaska.net */
end /* % */
Call Close out /* Mom mom@aol.com */
Return
WriteMSG:
Call AddTDL /* get the distribution list */
drop EVENT. /* make sure you free up the event */
address(BBSREAD)
'UNIQUEMSGFILE bbsname "'TB_SYSTEM'" stem "'TDLFILE'"'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
Return
end
Address(ThorPort)
'REQUESTSTRING TITLE "Please enter your subject:" BT "_Ok|_Cancel" ID "DLManager v1.0" MAXCHARS 100'
EVENT.SUBJECT = result
if( rc ~= 0 | EVENT.SUBJECT = '') then
EVENT.SUBJECT = '(No Subject)' /* You always have to have a subject! */
'StartEditor "'TDLFILE.NAME'"' /* Start whatever configured editor you are using */
EVENT.CONFERENCE = 'EMail'
EVENT.MSGFILE = TDLFILE.FILEPART
Call Open fh, choice, 'R'
user = readln(fh)
do while(~eof(fh))
if(user = '%') then
do
user = readln(fh)
nrwords = Words(user)
EVENT.TOADDR = Word(user, nrwords)
if(nrwords = 3) then
nrwords = nrwords-2 /* are there two words? or one? */
else
nrwords = nrwords-1
new = GetListName(Choice)
EVENT.TONAME = new
Address BBSREAD
'WRITEBREVENT bbsname "'TB_SYSTEM'" event "'EVE_ENTERMSG'" stem "'EVENT'"'
if(rc ~= 0) then
do
Address(ThorPort)
'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
Call Close(fh) /* insanity check! */
Return
end
user = readln(fh)
end
end
Call Close(fh)
Return
DeleteList:
Address(ThorPort)
'RequestFile Title "Select the .tdl file to delete" ID "'GC.SAVEDIR'" FP PAT "#?.tdl"'
if(rc = 5) then
do
'RequestNotify Text "File Delete Aborted!" BT "_Whew!"'
Return
end
Address Command 'Delete <>NIL: 'result
'RequestNotify Text "File Deleted!" BT "_YES!"'
Return
Quit:
Address(ThorPort)
'RequestNotify Text "Do you really\nwant to quit?" BT "_Yes|Heck No!"'
if(rc ~= 0) then
do
'RequestNotify Text "'THOR.LASTERROR'" BT "_OK"'
Call Cleanup
end
if ( result = 0 ) then Call WaitStuff
if ( result = 1 ) then Call Cleanup
Return
SYNTAX:
SAY 'SYNTAX ERROR'
SAY 'Error 'rc' in line 'sigl': 'errortext(rc)
HALT:
Cleanup:
Call CloseWindow(DLHOST)
fini = 1
Exit
GetListName: procedure
parse arg name
psn = Lastpos('/', name)
psn = psn+1
listname = substr(name, psn)
len = Length(listname)
posn = len-4
lname = left(listname, posn)
Return(lname)